home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / util / gnu / gnuemac_dev1_1.lha / cpr.el < prev    next >
Lisp/Scheme  |  1992-12-29  |  18KB  |  511 lines
  1. ;; Run cpr under Emacs
  2. ;; Copyright (C) 1988 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 1, or (at your option)
  9. ;; any later version.
  10.  
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;; GNU General Public License for more details.
  15.  
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  18. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. ;; Original of the gdb package : W. Schelter, University of Texas
  21. ;;     wfs@rascal.ics.utexas.edu
  22. ;; Rewritten by rms.
  23.  
  24. ;; Some ideas are due to  Masanobu. 
  25.  
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27. ;;
  28. ;; These lines describe the changes to gdb.el that were made in order to create
  29. ;; a CPR-compatible package.
  30. ;;
  31. ;; Author of the CPR package : C. Beust, Bull/Inria, Sophia Antipolis, Nice
  32. ;;     beust@sa.inria.fr
  33.  
  34. ;; M-s steps by one line, and redisplays the source file and line.
  35. ;; M-SPC steps one source line over functions
  36. ;; M-c   continues normal running
  37. ;;
  38. ;; All the other commands were kept as is except the ones that don't exist in
  39. ;; CPR (frame up/down for example).
  40. ;;
  41. ;; Instead of the shell mode, I chose to use comint.el as an underlying mode
  42. ;; for CPR operations. comint.el is far ahead shell.el and using this latter
  43. ;; is now pure heresy...
  44. ;;
  45. ;; Main advantages brought by the comint mode :
  46. ;;
  47. ;; M-p  Recall previous line of input (like ^P under a regular shell)
  48. ;; M-n  Recall next line of input (like ^N under a regular shell)
  49. ;;
  50. ;; Press C-hm for in the *cpr* buffer for more information on comint.
  51. ;;
  52. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  53.  
  54.  
  55. ;; Description of CPR interface:
  56.  
  57. ;; A facility is provided for the simultaneous display of the source code
  58. ;; in one window, while using cpr to step through a function in the
  59. ;; other.  A small arrow in the source window, indicates the current
  60. ;; line.
  61.  
  62. ;; Starting up:
  63.  
  64. ;; In order to use this facility, invoke the command CPR to obtain a
  65. ;; shell window with the appropriate command bindings.  You will be asked
  66. ;; for the name of a file to run.  Cpr will be invoked on this file, in a
  67. ;; window named *cpr-foo* if the file is foo.
  68.  
  69.  
  70. ;; You may easily create additional commands and bindings to interact
  71. ;; with the display.  For example to put the cpr command next on \M-n
  72. ;; (def-cpr next "\M-n")
  73.  
  74. ;; This causes the emacs command cpr-next to be defined, and runs
  75. ;; cpr-display-frame after the command.
  76.  
  77. ;; cpr-display-frame is the basic display function.  It tries to display
  78. ;; in the other window, the file and line corresponding to the current
  79. ;; position in the cpr window.  For example after a cpr-step, it would
  80. ;; display the line corresponding to the position for the last step.  Or
  81. ;; if you have done a backtrace in the cpr buffer, and move the cursor
  82. ;; into one of the frames, it would display the position corresponding to
  83. ;; that frame.
  84.  
  85. ;; cpr-display-frame is invoked automatically when a filename-and-line-number
  86. ;; appears in the output.
  87.  
  88.  
  89. (require 'comint)
  90.  
  91. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  92. ;; The following functions were added for CPR portability
  93. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  94.  
  95. ;; This regexp matches a function name followed by its arguments. It sets the
  96. ;; meta-argument to the name of the function.
  97. (defvar cpr-function-name-regexp "\\([^(]+\\)([^)]*)")
  98.  
  99. (defun cpr-function-name (name line)
  100.   "This should belong to C-mode. It returns the name of the function which
  101.    contains 'line' in the buffer 'name'. Might be bogus since the only way
  102.    I found to locate this function is by assuming it is followed by '^{'"
  103.   (save-window-excursion
  104.     (save-excursion
  105.       (save-restriction
  106.     (widen)
  107.     (if (re-search-backward "^{" 0 t)
  108.         (if (re-search-backward cpr-function-name-regexp)
  109.         (progn
  110.           (backward-word 1)
  111.           (re-search-forward cpr-function-name-regexp)
  112.           (buffer-substring (match-end 1) (match-beginning 1))
  113.           ) ;; progn
  114.           "** couldn't locate function with regexp **")
  115.       "** couldn't locate function with ^{ **")
  116.     ) ;; save-restriction
  117.       ) ;; save-excursion
  118.   ) ;; save-window-excursion
  119. )
  120.  
  121.  
  122. ;; This regexp matches the format of the coordinates as displayed by CPR. For
  123. ;; example :      'prog:\prog.c\main 29'
  124. ;; The meta-argument 1 is set to the source name (prog.c) and number 2 is the
  125. ;; line number
  126. (defvar cpr-location-regexp "^[^0-9:]+:.\\([^\\]+\\)[^ ]+ \\([0-9]+\\)")
  127.  
  128. (defun cpr-transform-string (string)
  129.   (cpr-perform-transformation string)
  130. )
  131.  
  132.  
  133. (defun cpr-perform-transformation (string)
  134.   "Convert a cpr-string (prog:\prog.c\main 29) into a gdb-string
  135.    (\032\032prog.c:29:CHARPOS). CHARPOS is set to zero since it doesn't
  136.    seem to be used by the package (might induce a bug)."
  137.   (let ((result string))
  138.     (if (string-match cpr-location-regexp string)
  139.     (progn
  140.       (setq result
  141.         (concat
  142.          "\032\032"
  143.          (substring string (match-beginning 1) (match-end 1))
  144.          ":"
  145.          (substring string (match-beginning 2) (match-end 2))
  146.          ":"
  147.          "0"
  148.         )
  149.        ); setq
  150.       ) ;; progn
  151.     ) ;; if
  152.     result))
  153.  
  154. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  155.  
  156. ;; gdb-old :
  157. ;; (defvar cpr-prompt-pattern "^(.*cpr[+]?) *"
  158. (defvar cpr-prompt-pattern "^>"
  159.   "A regexp to recognize the prompt for cpr or cpr+.") 
  160.  
  161. (defvar cpr-mode-map nil
  162.   "Keymap for cpr-mode.")
  163.  
  164. (if cpr-mode-map
  165.    nil
  166.   (setq cpr-mode-map (copy-keymap comint-mode-map))
  167.   (define-key cpr-mode-map "\C-l" 'cpr-refresh))
  168.  
  169. (define-key ctl-x-map " " 'cpr-break)
  170. (define-key ctl-x-map "&" 'send-cpr-command)
  171.  
  172. ;;Of course you may use `def-cpr' with any other cpr command, including
  173. ;;user defined ones.   
  174.  
  175. (defmacro def-cpr (name key &optional doc)
  176.   (let* ((fun (intern (format "cpr-%s" name)))
  177.      (cstr (list 'if '(not (= 1 arg))
  178.              (list 'format "%s %s" name 'arg)
  179.              name)))
  180.     (list 'progn
  181.        (list 'defun fun '(arg)
  182.         (or doc "")
  183.         '(interactive "p")
  184.         (list 'cpr-call cstr))
  185.       (list 'define-key 'cpr-mode-map key  (list 'quote fun)))))
  186.  
  187. (def-cpr "proceed"   "\M-n" "Step one source line with display")
  188. (def-cpr "cont"   "\M-c" "Continue with display")
  189.  
  190. (def-cpr "finish" "\C-c\C-f" "Finish executing current function")
  191.  
  192. (defun cpr-mode ()
  193.   "Major mode for interacting with an inferior Cpr process.
  194. The following commands are available:
  195.  
  196. \\{cpr-mode-map}
  197.  
  198. \\[cpr-display-frame] displays in the other window
  199. the last line referred to in the cpr buffer.
  200.  
  201. \\[cpr-step],\\[cpr-next], and \\[cpr-nexti] in the cpr window,
  202. call cpr to step,next or nexti and then update the other window
  203. with the current file and position.
  204.  
  205. If you are in a source file, you may select a point to break
  206. at, by doing \\[cpr-break].
  207.  
  208. Commands:
  209. Many commands are inherited from shell mode. 
  210. Additionally we have:
  211.  
  212. \\[cpr-display-frame] display frames file in other window
  213. \\[cpr-step] advance one line in program
  214. \\[cpr-next] advance one line in program (skip over calls).
  215. \\[send-cpr-command] used for special printing of an arg at the current point.
  216. C-x SPACE sets break point at current line."
  217.   (interactive)
  218.   (kill-all-local-variables)
  219.   (setq major-mode 'cpr-mode)
  220.   (setq mode-name "Inferior Cpr")
  221.   (setq mode-line-process '(": %s"))
  222.   (use-local-map cpr-mode-map)
  223.   (make-local-variable 'comint-last-input-start)
  224.   (setq comint-last-input-start (make-marker))
  225.   (make-local-variable 'comint-last-input-end)
  226.   (setq comint-last-input-end! (make-marker))
  227.   (make-local-variable 'cpr-last-frame)
  228.   (setq cpr-last-frame nil)
  229.   (make-local-variable 'cpr-last-frame-displayed-p)
  230.   (setq cpr-last-frame-displayed-p t)
  231.   (make-local-variable 'cpr-delete-prompt-marker)
  232.   (setq cpr-delete-prompt-marker nil)
  233.   (make-local-variable 'cpr-filter-accumulator)
  234.   (setq cpr-filter-accumulator nil)
  235.   (make-local-variable 'comint-prompt-regexp)
  236.   (setq comint-prompt-regexp cpr-prompt-pattern)
  237.   (run-hooks 'shell-mode-hook 'cpr-mode-hook)
  238. )
  239.  
  240. (defvar current-cpr-buffer nil)
  241.  
  242. (defvar cpr-command-name "cpr"
  243.   "Pathname for executing cpr.")
  244.  
  245. (defun cpr (path)
  246.   "Run cpr on program FILE in buffer *cpr-FILE*.
  247. The directory containing FILE becomes the initial working directory
  248. and source-file directory for CPR.  If you wish to change this, use
  249. the CPR commands `cd DIR' and `directory'."
  250. ;;  (interactive "FRun cpr on file: ")
  251.   (interactive (comint-get-source "Run cpr on file: " () '(c-mode) t))
  252.   (setq path (expand-file-name path))
  253.   (let ((file (file-name-nondirectory path)))
  254.     (switch-to-buffer (concat "*cpr-" file "*"))
  255.     (setq default-directory (file-name-directory path))
  256.     (or (bolp) (newline))
  257.     (insert "Current directory is " default-directory "\n")
  258. ;;gdb-old :
  259. ;;    (make-shell (concat "cpr-" file) cpr-command-name nil "-fullname"
  260. ;;        "-cd" default-directory file)
  261.  
  262. ;; cpr-new :
  263.     (comint-mode)
  264.     (make-comint (concat "cpr-" file) cpr-command-name nil "-line" file)
  265.  
  266.     (cpr-mode)
  267.     (set-process-filter (get-buffer-process (current-buffer)) 'cpr-filter)
  268.     (set-process-sentinel (get-buffer-process (current-buffer)) 'cpr-sentinel)
  269.     (cpr-set-buffer)))
  270.  
  271. (defun cpr-set-buffer ()
  272.   (cond ((eq major-mode 'cpr-mode)
  273.     (setq current-cpr-buffer (current-buffer)))))
  274.  
  275. ;; This function is responsible for inserting output from CPR
  276. ;; into the buffer.
  277. ;; Aside from inserting the text, it notices and deletes
  278. ;; each filename-and-line-number;
  279. ;; that CPR prints to identify the selected frame.
  280. ;; It records the filename and line number, and maybe displays that file.
  281. (defun cpr-filter (proc string)
  282. ;; cpr-new :
  283.   (setq string (cpr-transform-string string))
  284. ;;
  285.   (let ((inhibit-quit t))
  286.     (if cpr-filter-accumulator
  287.     (cpr-filter-accumulate-marker proc
  288.                       (concat cpr-filter-accumulator string))
  289.     (cpr-filter-scan-input proc string))))
  290.  
  291. (defun cpr-filter-accumulate-marker (proc string)
  292.   (setq cpr-filter-accumulator nil)
  293.   (if (> (length string) 1)
  294.       (if (= (aref string 1) ?\032)
  295.       (let ((end (string-match "\n" string)))
  296.         (if end
  297.         (progn
  298.           (let* ((first-colon (string-match ":" string 2))
  299.              (second-colon
  300.               (string-match ":" string (1+ first-colon))))
  301.             (setq cpr-last-frame
  302.               (cons (substring string 2 first-colon)
  303.                 (string-to-int
  304.                  (substring string (1+ first-colon)
  305.                         second-colon)))))
  306.           (setq cpr-last-frame-displayed-p nil)
  307.           (cpr-filter-scan-input proc
  308.                      (substring string (1+ end))))
  309.           (setq cpr-filter-accumulator string)))
  310.     (cpr-filter-insert proc "\032")
  311.     (cpr-filter-scan-input proc (substring string 1)))
  312.     (setq cpr-filter-accumulator string)))
  313.  
  314. (defun cpr-filter-scan-input (proc string)
  315.   (if (equal string "")
  316.       (setq cpr-filter-accumulator nil)
  317.       (let ((start (string-match "\032" string)))
  318.     (if start
  319.         (progn (cpr-filter-insert proc (substring string 0 start))
  320.            (cpr-filter-accumulate-marker proc
  321.                          (substring string start)))
  322.         (cpr-filter-insert proc string)))))
  323.  
  324. (defun cpr-filter-insert (proc string)
  325.  
  326.   (let ((moving (= (point) (process-mark proc)))
  327.     (output-after-point (< (point) (process-mark proc)))
  328.     (old-buffer (current-buffer))
  329.     start)
  330.     (set-buffer (process-buffer proc))
  331.     (unwind-protect
  332.     (save-excursion
  333.       ;; Insert the text, moving the process-marker.
  334.       (goto-char (process-mark proc))
  335.       (setq start (point))
  336.       (insert string)
  337.       (set-marker (process-mark proc) (point))
  338.       (cpr-maybe-delete-prompt)
  339.       ;; Check for a filename-and-line number.
  340.       (cpr-display-frame
  341.        ;; Don't display the specified file
  342.        ;; unless (1) point is at or after the position where output appears
  343.        ;; and (2) this buffer is on the screen.
  344.        (or output-after-point
  345.            (not (get-buffer-window (current-buffer))))
  346.        ;; Display a file only when a new filename-and-line-number appears.
  347.        t))
  348.       (set-buffer old-buffer))
  349.     (if moving (goto-char (process-mark proc)))))
  350.  
  351. (defun cpr-sentinel (proc msg)
  352.   (cond ((null (buffer-name (process-buffer proc)))
  353.      ;; buffer killed
  354.      ;; Stop displaying an arrow in a source file.
  355.      (setq overlay-arrow-position nil)
  356.      (set-process-buffer proc nil))
  357.     ((memq (process-status proc) '(signal exit))
  358.      ;; Stop displaying an arrow in a source file.
  359.      (setq overlay-arrow-position nil)
  360.      ;; Fix the mode line.
  361.      (setq mode-line-process
  362.            (concat ": "
  363.                (symbol-name (process-status proc))))
  364.      (let* ((obuf (current-buffer)))
  365.        ;; save-excursion isn't the right thing if
  366.        ;;  process-buffer is current-buffer
  367.        (unwind-protect
  368.            (progn
  369.          ;; Write something in *compilation* and hack its mode line,
  370.          (set-buffer (process-buffer proc))
  371.          ;; Force mode line redisplay soon
  372.          (set-buffer-modified-p (buffer-modified-p))
  373.          (if (eobp)
  374.              (insert ?\n mode-name " " msg)
  375.            (save-excursion
  376.              (goto-char (point-max))
  377.              (insert ?\n mode-name " " msg)))
  378.          ;; If buffer and mode line will show that the process
  379.          ;; is dead, we can delete it now.  Otherwise it
  380.          ;; will stay around until M-x list-processes.
  381.          (delete-process proc))
  382.          ;; Restore old buffer, but don't restore old point
  383.          ;; if obuf is the cpr buffer.
  384.          (set-buffer obuf))))))
  385.  
  386.  
  387. (defun cpr-refresh ()
  388.   "Fix up a possibly garbled display, and redraw the arrow."
  389.   (interactive)
  390.   (redraw-display)
  391.   (cpr-display-frame))
  392.  
  393. (defun cpr-display-frame (&optional nodisplay noauto)
  394.   "Find, obey and delete the last filename-and-line marker from CPR.
  395. The marker looks like \\032\\032FILENAME:LINE:CHARPOS\\n.
  396. Obeying it means displaying in another window the specified file and line."
  397.   (interactive)
  398.   (cpr-set-buffer)
  399.   (and cpr-last-frame (not nodisplay)
  400.        (or (not cpr-last-frame-displayed-p) (not noauto))
  401.        (progn (cpr-display-line (car cpr-last-frame) (cdr cpr-last-frame))
  402.           (setq cpr-last-frame-displayed-p t))))
  403.  
  404. ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
  405. ;; and that its line LINE is visible.
  406. ;; Put the overlay-arrow on the line LINE in that buffer.
  407.  
  408. (defun cpr-display-line (true-file line)
  409.   (let* ((buffer (find-file-noselect true-file))
  410.      (window (display-buffer buffer t))
  411.      (pos))
  412.     (save-excursion
  413.       (set-buffer buffer)
  414.       (save-restriction
  415.     (widen)
  416.     (goto-line line)
  417.     (setq pos (point))
  418.     (setq overlay-arrow-string "=>")
  419.     (or overlay-arrow-position
  420.         (setq overlay-arrow-position (make-marker)))
  421.     (set-marker overlay-arrow-position (point) (current-buffer)))
  422.       (cond ((or (< pos (point-min)) (> pos (point-max)))
  423.          (widen)
  424.          (goto-char pos))))
  425.     (set-window-point window overlay-arrow-position)))
  426.  
  427. (defun cpr-call (command)
  428.   "Invoke cpr COMMAND displaying source in other window."
  429.   (interactive)
  430.   (goto-char (point-max))
  431.   (setq cpr-delete-prompt-marker (point-marker))
  432.   (cpr-set-buffer)
  433.   (send-string (get-buffer-process current-cpr-buffer)
  434.            (concat command "\n")))
  435.  
  436. (defun cpr-maybe-delete-prompt ()
  437.   (if (and cpr-delete-prompt-marker
  438.        (> (point-max) (marker-position cpr-delete-prompt-marker)))
  439.       (let (start)
  440.     (goto-char cpr-delete-prompt-marker)
  441.     (setq start (point))
  442.     (beginning-of-line)
  443.     (delete-region (point) start)
  444.     (setq cpr-delete-prompt-marker nil))))
  445.  
  446. (defun cpr-break ()
  447.   "Set CPR breakpoint at this source line."
  448.   (interactive)
  449.   (let* ((file-name (file-name-nondirectory buffer-file-name))
  450.     (line (save-restriction
  451.         (widen)
  452.         (1+ (count-lines 1 (point)))))
  453.     (function (cpr-function-name file-name line)))
  454. ;; gdb-old:
  455. ;;    (send-string (get-buffer-process current-cpr-buffer)
  456. ;;         (concat "break " file-name ":" line "\n"))))
  457. ;; cpr-new :
  458.     (send-string (get-buffer-process current-cpr-buffer)
  459.          (concat "break \\" file-name "\\" function " " line "\n"))
  460.     (send-string (get-buffer-process current-cpr-buffer)
  461.          (concat "blist\n"))
  462.     )
  463. )
  464.  
  465.  
  466. (defun cpr-read-address()
  467.   "Return a string containing the core-address found in the buffer at point."
  468.   (save-excursion
  469.    (let ((pt (dot)) found begin)
  470.      (setq found (if (search-backward "0x" (- pt 7) t)(dot)))
  471.      (cond (found (forward-char 2)(setq result
  472.             (buffer-substring found
  473.                  (progn (re-search-forward "[^0-9a-f]")
  474.                     (forward-char -1)
  475.                     (dot)))))
  476.        (t (setq begin (progn (re-search-backward "[^0-9]") (forward-char 1)
  477.                  (dot)))
  478.           (forward-char 1)
  479.           (re-search-forward "[^0-9]")
  480.           (forward-char -1)
  481.           (buffer-substring begin (dot)))))))
  482.  
  483.  
  484. (defvar cpr-commands nil
  485.   "List of strings or functions used by send-cpr-command.
  486. It is for customization by you.")
  487.  
  488. (defun send-cpr-command (arg)
  489.  
  490.   "This command reads the number where the cursor is positioned.  It
  491.  then inserts this ADDR at the end of the cpr buffer.  A numeric arg
  492.  selects the ARG'th member COMMAND of the list cpr-print-command.  If
  493.  COMMAND is a string, (format COMMAND ADDR) is inserted, otherwise
  494.  (funcall COMMAND ADDR) is inserted.  eg. \"p (rtx)%s->fld[0].rtint\"
  495.  is a possible string to be a member of cpr-commands.  "
  496.  
  497.  
  498.   (interactive "P")
  499.   (let (comm addr)
  500.     (if arg (setq comm (nth arg cpr-commands)))
  501.     (setq addr (cpr-read-address))
  502.     (if (eq (current-buffer) current-cpr-buffer)
  503.     (set-mark (point)))
  504.     (cond (comm
  505.        (setq comm
  506.          (if (stringp comm) (format comm addr) (funcall comm addr))))
  507.       (t (setq comm addr)))
  508.     (switch-to-buffer current-cpr-buffer)
  509.     (goto-char (dot-max))
  510.     (insert-string comm)))
  511.